' Display stuff, used to draw the control and also
' to evaluate menu font item sizes:
Private m_HDC As Long
Private m_hBMPDither As Long
Private m_bUseDither As Boolean
Private m_hFntOld As Long
Private m_bGotFont As Boolean
' Handle to image list for drawing icons:
Private m_hIml As Long
' Where to get a tick icon for checked stuff (or -1 to use Win default):
Private m_lTickIconIndex As Long
' Where to get a option button icon for checked stuff (or -1 to use Win default)
Private m_lOptionIconIndex As Long
' hWNd of owner:
Private m_hWndOwner As Long
Private m_hWndAttached As Long
' Height of a menu item:
Private m_lMenuItemHeight As Long
' Bitmap to tile into background of menu:
Private m_hDCBack As Long
Private m_hBmpOld As Long
Private m_hBmp As Long
Private m_lBitmapW As Long
Private m_lBitmapH As Long
' Sub menus:
Private m_lSubMenuCount As Long
Private m_hSubMenus() As Long
' Next id to choose for a menu item:
Private m_lLastMaxId As Long
Private m_bGradientHighlight As Boolean
Private m_sTag As String
Private m_bDrawHeadersAsSeparators As Boolean
Public Enum ECNMHeaderStyle
ecnmHeaderCaptionBar = 0
ecnmHeaderSeparator = 1
End Enum
' Events:
Public Event Click(ItemNumber As Long)
Attribute Click.VB_Description = "Fired when a menu item is clicked AND the CreateSubClass method has been called since the menu was last shown. Normally the return value of the ShowPopupMenu event tells you which item is clicked."
Public Event ItemHighlight(ItemNumber As Long, bEnabled As Boolean, bSeparator As Boolean)
Attribute ItemHighlight.VB_Description = "Raised when an item is highlighted in a pop-up menu."
Public Event MenuExit()
Attribute MenuExit.VB_Description = "Raised when a popup menu is exited."
Public Event InitPopupMenu(ParentItemNumber As Long)
Attribute InitPopupMenu.VB_Description = "Raised when a submenu is about to be shown. You can modify the pop-up menu's contents in this event without any problem."
Public Event DrawItem(ByVal hdc As Long, ByVal lMenuIndex As Long, ByRef lLeft As Long, ByRef lTop As Long, ByRef lRight As Long, ByRef lBottom As Long, ByVal bSelected As Boolean, ByVal bChecked As Boolean, ByVal bDisabled As Boolean, bDoDefault As Boolean)
Public Event MeasureItem(ByVal lMenuIndex As Long, ByRef lWidth As Long, ByRef lHeight As Long)
Public Property Set BackgroundPicture( _
ByRef sPic As StdPicture _
)
Attribute BackgroundPicture.VB_Description = "Sets a StdPicture object to tile behind the menu items. Use ClearBackgroundPicture to remove the picture again."
Public Property Get IDForItem(ByVal lIndex As Long) As Long
Attribute IDForItem.VB_Description = "Returns the Menu ID used to identify a menu item. If the menu has a child menu, this will be the menu handle of the child menu."
If lIndex > 0 And lIndex <= m_iMenuCount Then
IDForItem = m_tMI(lIndex).lActualID
End If
End Property
Public Property Get ItemForID(ByVal wID As Long) As Long
Attribute ItemForID.VB_Description = "Returns the Index of the menu item with the specified ID."
Dim lIndex As Long
For lIndex = 1 To m_iMenuCount
If m_tMI(lIndex).lActualID = wID Then
ItemForID = lIndex
Exit For
End If
Next lIndex
End Property
Public Sub EmulateMenuClick(ByVal wID As Long)
Attribute EmulateMenuClick.VB_Description = "Given the ID of a menu item, calls the code cPopupMenu would normally run when the item is clicked."
Dim lIndex As Long
For lIndex = 1 To m_iMenuCount
If m_tMI(lIndex).lActualID = wID Then
RaiseClickEvent wID
Exit For
End If
Next lIndex
End Sub
Public Property Get GradientHighlight() As Boolean
Attribute GradientHighlight.VB_Description = "Gets/sets whether highlights on the menu are drawn with a gradient or not."
GradientHighlight = m_bGradientHighlight
End Property
Public Property Let GradientHighlight(ByVal bState As Boolean)
m_bGradientHighlight = bState
End Property
Public Property Get HeaderStyle() As ECNMHeaderStyle
Attribute HeaderStyle.VB_Description = "Gets/sets how header style menu items will be drawn. Header style items can either be drawn in an ICQ-style (when a standard menu separator is drawn but the text is rendered in a small font) or in a small window caption style."
If (m_bDrawHeadersAsSeparators) Then
HeaderStyle = ecnmHeaderSeparator
Else
HeaderStyle = ecnmHeaderCaptionBar
End If
End Property
Public Property Let HeaderStyle(ByVal eStyle As ECNMHeaderStyle)
If (eStyle = ecnmHeaderCaptionBar) Then
m_bDrawHeadersAsSeparators = False
Else
m_bDrawHeadersAsSeparators = True
End If
End Property
Public Property Get Count() As Long
Attribute Count.VB_Description = "Gets the number of items in the menu."
Count = m_iMenuCount
End Property
Public Property Get HighlightCheckedItems() As Boolean
Attribute HighlightCheckedItems.VB_Description = "Gets/sets whether checked items should be highlighted when the menu item is selected."
HighlightCheckedItems = m_bUseDither
End Property
Public Property Let HighlightCheckedItems(ByVal bState As Boolean)
Attribute Tag.VB_Description = "Gets/sets a string associated with the popup-menu object."
Tag = m_sTag
End Property
Public Property Let Tag(ByVal sTag As String)
m_sTag = sTag
End Property
Public Property Get hWndOwner() As Long
Attribute hWndOwner.VB_Description = "Sets the owning window of the popup menu. This must be set before any popup menus are shown."
hWndOwner = m_hWndOwner
End Property
Public Property Let hWndOwner(ByVal hWndA As Long)
Dim lHDC As Long
' Clear up:
Clear
' Clear DC:
If (m_HDC <> 0) Then
If (m_hFntOld <> 0) Then
SelectObject m_HDC, m_hFntOld
End If
DeleteObject m_HDC
End If
' Set for new owner:
m_hWndOwner = hWndA
lHDC = GetDC(hWndA)
m_HDC = CreateCompatibleDC(lHDC)
ReleaseDC m_hWndOwner, lHDC
' Select the menu font into it:
pSelectMenuFont
End Property
Public Property Let ImageList( _
ByRef vImageList As Variant _
)
Attribute ImageList.VB_Description = "Associates an ImageList with the Popup menu for setting icons. This may be set to either a VB ImageList control or a hImageList API handle."
